home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
ptool.arc
/
PTOOLENT.INC
next >
Wrap
Text File
|
1985-06-06
|
21KB
|
485 lines
{ PTOOLENT.INC Copyright 1984 R D Ostrander Version 1.0
Ostrander Data Services
5437 Honey Manor Dr
Indianapolis IN 46241
This Turbo Pascal include file is a display and data entry tool. It Displays
a given String (or Character Array), Integer, or Real (Dollar) data field
in a given screen area and allows the operator to make changes via the
keyboard. It allows the operator to end the editing using many ending
keys and passes information about those keys to the calling program.
This program has been placed in the Public Domain by the author and copies
may be freely made for non-commercial, demonstration, or evaluation purposes.
Use of these subroutines in a program for sale or for commercial purposes in
a place of business requires a $20 fee be paid to the author at the address
above. Personal non-commercial users may also elect to pay the $20 fee to
encourage further development of this and similar programs. With payment you
will be able to receive update notices, diskettes and printed documentation
of this and other PTOOLs from Ostrander Data Services.
PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
Turbo Pascal is a Copyright of Borland International Inc.
Call format is:
Set Data <String, Integer, or Real> initial display value.
Set DataType <Char> type of edit.
Set DisplaySize <Integer> number of spaces for display.
Set DisplayDecimals <Integer> for Real numbers only.
Set ReturnCode <Integer> need not be set but must be a variable.
GoToXY (X, Y) to set the Display Area location.
PTOOLENT (Data, DataType, DisplaySize, DisplayDecimals, ReturnCode);
Examples: Var CustomerName : String [24];
ReturnCode : Integer;
Begin
CustomerName := ' ';
Gotoxy (1,1)
PTOOLENT (CustomerName, 'S', 24, 0, ReturnCode);
See companion program PTOOLENT.PAS for further examples.
Note that the DisplaySize must be > DisplayDecimals + 1.
Invalid data and cursor movements cause beeps to the operator.
Editing Keys are:
Left Arrow : Move cursor to left
Right Arrow : Move cursor to right
Ctrl-Left Arrow : Move cursor to 1st position
Ctrl-Right Arrow : Move cursor past last character
Tab : Move cursor right to next word
Shift-Tab : Move cursor left to previous word
Backspace : Erase character to left of cursor
Del : Erase character under cursor
Ctrl-E : Erase editing area
Ctrl-F : Fill field with character to left of cursor
Ctrl-X : Erase all characters from cursor on
Ctrl-L : Left justify data
Ctrl-R : Right justify data
Ctrl-S : Start Editing over
Ctrl-N or Ctrl-Q : Quit with no change in data
Ctrl-P : Retreive Previous data or Ctrl-E(rased) data
Ctrl-U : Change all data to Upper Case
Ctrl-D : Change all data to Lower Case
Ins : Toggle Insert function on/off
Alt-Numerics may be used to enter character graphics codes
Edit Return codes are:
0 = Esc
1 = C/R or Ctrl-N or Ctrl-Q
2 = (Filled Field)
3 = Ctrl-Break/Ctrl-C (if $C- not set)
16-26, 30-38, 44,50 = Alt-Alphabetics
59-68 = F1 - F10
71 = Home
72 = Up Arrow
73 = PgUp
79 = End
80 = Down Arrow
81 = PgDn
84-93 = Shift F1 - F10
94-103 = Ctrl F1 - F10
104-113 = Alt F1 - F10
114 = Ctrl-PrtSc
117 = Ctrl-End
118 = Ctrl-PgDn
119 = Ctrl-Home
132 = Ctrl-PgUp }
Procedure PTOOLENT (VAR Data; { Note - Untyped }
TypeData : Char; { Must be I, R, or S }
Size, { Must be 1 to 80 }
Decimals : Integer; { Only for type R }
VAR OutEndCode : Integer); { Return Code }
Var
PassI : Integer absolute Data; { Initial Data }
PassR : Real absolute Data;
PassS : String [80] absolute Data;
Ch, Ch2 : Char; { Keyboard Input }
CurrS, SaveS : String [80]; { Working Data }
I, J : Integer; { Position Pointers }
DispX, DispY : Integer; { Initial Cursor Location }
Done : Boolean; { Switch for end of edit }
ErrCode : Integer; { Used for String to Numeric }
Dot : Char; { Space character on screen }
Const
InsertKey : Boolean = False; { Insert On/Off Switch }
PrevS : String [80] = 'No data available'; { Holding area for Ctrl-P }
Function PowerOf (Number, Power : Integer) : Real; { Exponentiation Routine }
Var
J : Integer;
Work : Real;
Begin
Work := Number;
For J := 1 to Power - 1 do
Work := Work * 10;
PowerOf := Work;
End;
Function LowCase (Ch : Char) : Char; { Convert Upper to Lower Case }
Begin
If Ord (Ch) in [65 .. 90] then
LowCase := Char (Ord (Ch) + 32)
else
LowCase := Ch;
End;
Procedure Beep; { Make a short sound }
Begin
Sound (880);
Delay (150);
NoSound;
End;
Procedure Display; { Display the Current Data }
Begin
Gotoxy (DispX, DispY);
CurrS [0] := Char(Size);
Write (CurrS);
End;
Procedure AddASpace; { Put a Dot at the Right end of the Data }
Begin
Insert (Dot, CurrS, Size + 1);
End;
Procedure LeftJustify; { Left Justify the data }
Begin
For J := 1 to Size do
If CurrS [1] = Dot then
Begin
Delete (CurrS, 1, 1);
AddASpace;
End;
End;
Procedure InsertSwitch; { Turn Insert On or Off (Toggle) }
type
BiosCall = Record
Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
End;
XferArea = Record
Case Boolean of
True : (Lo, Hi : Byte);
False : (I : Integer);
End;
var
BiosRec : BiosCall;
XferRec : XferArea;
Begin { Begin of InsertSwitch }
If InsertKey = True then InsertKey := False
else InsertKey := True;
XferRec.Lo := 0; { This calls IBM DOS BIOS to }
XferRec.Hi := 1; { alter the cursor mode. }
BiosRec.Ax := XferRec.I;
XferRec.Lo := 7;
If InsertKey = True then XferRec.Hi := 4
else XferRec.Hi := 6;
BiosRec.Cx := XferRec.I;
Intr(16, BiosRec);
End;
Label
DisplayPoint; { If there are errors in numeric data the program
returns to DisplayPoint. }
BEGIN { Begin of PTOOLENT Procedure }
Dot := Char (250); { A Little tiny Dot }
Done := False;
ErrCode := 0;
DispX := WhereX;
DispY := WhereY;
FillChar (CurrS, Size + 1, Dot);
Case TypeData of { Move }
'I' : If PassI <> 0 then Str (PassI:Size, CurrS); { input }
'R' : If PassR <> 0 then Str (PassR:Size:Decimals, CurrS); { data }
'S' : CurrS := PassS; { to }
End; {Case} { CurrS }
If (TypeData = 'I') or (TypeData = 'R') then { Left Justify }
For I := 1 to Size do { Numeric Data }
If CurrS [1] = ' ' then
Begin
Delete (CurrS, 1, 1);
AddASpace;
End;
For I := 1 to Size do
If CurrS [I] = ' ' then CurrS [I] := Dot;
CurrS [0] := Char (Size);
I := 1;
SaveS := CurrS;
DisplayPoint:
Display;
While NOT Done Do { Main editing loop }
Begin
If I < 1 then { Check cursor position }
Begin
I := 1;
Beep;
End;
If I > Size then
Begin
I := Size;
Beep;
End;
Gotoxy (DispX + I - 1, DispY);
Ch := Char(00); { Get Keyboard input }
Ch2 := Char(00); { This handles extended }
Read (KBD, Ch); { Keystrokes }
If Keypressed then Read (KBD, Ch2);
If Ord(Ch) = 27 then { If CH is 027 then }
Case Ord(Ch2) of { check second part }
{Back Tab } 15 : Begin
I := I - 1;
While ((CurrS [I] = Dot) or
(CurrS [I] = '.'))
and (I > 1) do
I := I - 1;
While (CurrS [I] <> Dot)
and (CurrS [I] <> '.')
and (I > 1) do
I := I - 1;
If (CurrS [I] = Dot) or
(CurrS [I] = '.') then I := I + 1;
End;
{Left Arrow } 75 : I := I -1;
{Right Arrow } 77 : I := I +1;
{Ins } 82 : InsertSwitch;
{Del } 83 : Begin
Delete (CurrS, I, 1);
AddASpace;
Display;
End;
{Ctrl-LeftArrow } 115 : If I = 1 then Beep
else I := 1;
{Ctrl-RightArrow} 116 : Begin
I := Size;
While (CurrS [I] = Dot)
and (I > 0) do
I := I - 1;
If I < Size then
I := I + 1;
End;
else Begin
Done := True;
OutEndCode := Ord(Ch2);
End;
End {Case}
else
Begin { If not 027 the check first }
If Ord (Ch) = 32 then
Ch := Dot; { Make space bar a dot }
Case Ord(Ch) of
{Ctrl-C End } 3 : Begin
Done := True;
OutEndCode := 3;
End;
{Ctrl-D LowCase} 4 : Begin
For J := 1 to Size do
CurrS [J] := LowCase (CurrS [J]);
Display;
End;
{Ctrl-E Erase } 5 : Begin
PrevS := CurrS;
FillChar (CurrS [1], Size, Dot);
Display;
I := 1;
End;
{Ctrl-F Fill } 6: Begin
If I > 1 then J := I - 1
else J := 1;
FillChar (CurrS [J + 1], Size - J,
CurrS [J]);
Display;
End;
{Backspace } 8 : If I > 1 then
Begin
Delete (CurrS, I - 1, 1);
AddASpace;
Display;
I := I - 1;
End
else Beep;
{Tab } 9 : Begin
While (CurrS [I] <> Dot)
and (CurrS [I] <> '.')
and (I < Size) do
I := I + 1;
While ((CurrS [I] = Dot) or
(CurrS [I] = '.'))
and (I < Size) do
I := I + 1;
End;
{Ctrl-L L-Just } 12 : Begin
LeftJustify;
Display;
I := 1;
End;
{C/R End } 13 : Begin
Done := True;
OutEndCode := 1;
End;
{Ctrl-N Quit } 14 : Begin
CurrS := SaveS;
Done := True;
OutEndCode := 1;
End;
{Ctrl-P Prev. } 16 : Begin
For I := 1 to Size do
CurrS [I] := PrevS [I];
I := 1;
Display;
End;
{Ctrl-Q Quit } 17 : Begin
CurrS := SaveS;
Done := True;
OutEndCode := 1;
End;
{Ctrl-R R-Just } 18 : Begin
I := Size;
While (CurrS [I] = Dot)
and (I > 0) do
I := I - 1;
If I < Size then
Begin
J := Size - I;
For I := 1 to J do
Insert (Dot, CurrS, 1);
End;
I := 1;
While CurrS [I] = Dot do
I := I + 1;
Display
End;
{Ctrl-S Restart} 19 : Begin
CurrS := SaveS;
I := 1;
Goto DisplayPoint;
End;
{Ctrl-U UpCase } 21 : Begin
For J := 1 to Size do
CurrS [J] := UpCase (CurrS [J]);
Display;
End;
{Ctrl-X ClrEol } 24 : Begin
FillChar (CurrS [I], Size - I + 1,
Dot);
Display;
End;
else If InsertKey = False then
Begin
Write (Ch);
CurrS [I] := Ch;
I := I + 1;
If I > Size then
Begin
Done := True;
OutEndCode := 2;
End;
End
else
Begin
Insert (Ch, CurrS, I);
I := I + 1;
Display;
If I > Size then
Begin
Done := True;
OutEndCode := 2;
End;
End;
End; {Case}
End;
End;
If (TypeData = 'I') { Left Justify Numeric data and }
or (TypeData = 'R') then { check for imbedded spaces }
Begin
LeftJustify;
I := 1;
While (CurrS [I] <> Dot)
and (I <= Size) do
I := I + 1;
For J := I to Size do
If CurrS [J] <> Dot then
Begin
Beep;
I := J - 1;
Done := False;
Goto DisplayPoint;
End;
CurrS [0] := Char (I - 1);
End;
If InsertKey = True then InsertSwitch; { Turn off insert }
ErrCode := 0;
If TypeData = 'I' then
Val (CurrS, PassI, ErrCode);
If TypeData = 'R' then { Check size of Real data - }
Begin { must leave room for decimals }
Val (CurrS, PassR, ErrCode);
If Decimals > 0 then
If (PassR >= PowerOf (10, Size - Decimals - 1))
or (PassR <= PowerOf (10, Size - Decimals - 2) * -1) then
Begin
Beep;
I := 1;
Done := False;
Goto DisplayPoint;
End;
End;
If ErrCode <> 0 then { If numeric data errors, transfer }
Begin { back to re-edit data. }
Beep;
Done := False;
I := ErrCode;
Goto DisplayPoint;
End;
If TypeData = 'S' then { Move String data }
Begin
For I := 1 to Size do
If CurrS [I] = Dot then CurrS [I] := ' ';
CurrS [0] := Char (Size);
PassS := CurrS;
End;
FillChar (PrevS, 80, Dot); { Save data }
PrevS := CurrS;
Gotoxy (DispX, DispY); { Display data }
Case TypeData of
'S' : Write (PassS);
'I' : Write (PassI:Size);
'R' : Write (PassR:Size:Decimals);
End; {case}
Gotoxy (DispX, DispY); { Reset cursor }
END;
